Night Owl 6/Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso/027a/proplus.zip/SAMPLE1.PRG

Text File | 1991-03-14 | 7KB | 209 lines

PUBLIC pp_cfile, demo_ver
PRIVATE password, get_code, choice, exe_limit
pp_cfile="SAMPLE"
if !pp_getvar()
    ? "Error reading control file... Call technical support!"
    ?
    cancel
endif
if pp_expired()
    ? "Sorry, but the demo for this product has expired... Please call and"
    ? "order from C.R.S. at 614-676-2771"
    ?
    pp_upddate()
    cancel
endif
if !pp_valdate() .AND. pp_exptype()#"N"
    clear
    curr_date=date()
    curr_time=time()
    @ 2,0 say "Please set the date and time correctly:"
    ?
    ?
    run date
    @ 7,0 say ""
    run time
endif
if !pp_valdate() .AND. pp_exptype()#"N"
    clear
    @ 2,0 say "The date and time is still incorrect.  Please call technical support"
    @ 3,0 say "for assistance.              Code entry #: "+ltrim(str(pp_cenum()))+"  Date: "+dtoc(date())
    propl0=4500
    get_code=0
    @ 5,0 say "Enter code: " get get_code picture "@Z"
    read
    if pp_ucode(get_code)=5
        pp_upddate()
        pp_getvar()
    else
        clear
        cancel
    endif
endif
exe_limit=( pp_exptype() = "E" )
if iscolor()
    setcolor("w+/b")
else
    setcolor("w")
endif
clear
set scoreboard off
@ 0,0 to 24,79
@ 1,13 say "P R O T E C T I O N   P L U S   F O R   C L I P P E R"
@ 4,2 say "    Serial: "+pp_serial()+"/"+ltrim(str(pp_compno()))
@ 5,2 say "Code entry: "+ltrim(str(pp_cenum()))
propl0=4500
@  4,64 say "Date: "+dtoc(date())
@  5,59 say "Last used: "+dtoc(propl17)
@  6,70 say propl18
@  7,61 say if(!empty(propl10),"Expires: "+dtoc(propl10),"")
@  8,24 say "Protection plus sample program!"
@ 10,22 say "This is your power-up screen routine"
set key -4 to ucode
password=space(8)
do while empty(password) .AND. !lastkey()=27
    @ 20,28 clear to 20,60
    @ 20,30 say "Password: " get password picture "@!"
    read
enddo
set key -4 to
if password#"PROPLUS "
    pp_upddate()
    set color to
    clear
    @ 2,0 say "Incorrect password entered, program aborted!"
    @ 4,0 say ""
    cancel
endif
if exe_limit
    pp_advect()
endif
clear
@ 0,0 to 24,79
@ 1,13 say "P R O T E C T I O N   P L U S   F O R   C L I P P E R"
choice=1
@ 7,3 to 12,20
do while .T.
    @ 2,21 clear to 23,78
    @  7,7 say "MAIN MENU"
    @  8,5 prompt "View variables"
    @  9,5 prompt "Edit variables"
    @ 10,5 prompt "Macro entry   "
    @ 11,5 prompt "Exit program  "
    @ 6,29 say "This is the Protection Plus sample program MAIN"
    @ 7,29 say "MENU.  There are some choices here that allow"
    @ 8,29 say "you to test out some of the features of the "
    @ 9,29 say "Protection Plus library.  Look the the source"
    @ 10,29 say "file SAMPLE.PRG for a full description of all"
    @ 11,29 say "the library functions used in this sample"
    @ 12,29 say "program.  It is EASY to implement the source"
    @ 13,29 say "changes in your own existing applications!"
    menu to choice
    do case
        case choice=1
            @ 2,21 clear to 23,78
            @  5,34 SAY "Company: "+propl1
            @  6,34 SAY "   Name: "+propl2
            @  7,34 SAY "Address: "+propl3
            @  8,34 SAY "   City: "+propl4+", "+propl5+"  "+propl6
            @  9,34 SAY "  Phone: "+propl7
            @ 10,34 SAY "Product: "+propl8
            @ 11,34 SAY "Serial#: "+propl9
            @ 12,34 SAY "Expires: "+dtoc(propl10)
            @ 13,34 SAY "Company: "+propl12
            @ 14,34 SAY "Address: "+propl13
            @ 15,34 SAY "         "+propl14
            @ 16,34 SAY "  Phone: "+propl15
            @ 17,34 SAY "    FAX: "+propl16
            @ 18,34 SAY "Last     "+dtoc(propl17)
            @ 19,34 SAY "   Used: "+propl18
            @ 21,34 say "Press any key..."
            inkey(0)
        case choice=2
            @ 2,21 clear to 23,78
            @  5,34 SAY "Company: " get propl1
            @  6,34 SAY "   Name: " get propl2
            @  7,34 SAY "Address: " get propl3
            @  8,34 SAY "   City: " get propl4
            @  8,61 get propl5
            @  8,65 get propl6
            @  9,34 SAY "  Phone: " get propl7
            @ 10,34 SAY "Product: " get propl8
            @ 11,34 SAY "Serial#: " get propl9
            @ 12,34 SAY "Expires: " get propl10
            @ 13,34 SAY "Company: " get propl12
            @ 14,34 SAY "Address: " get propl13
            @ 15,34 SAY "         " get propl14
            @ 16,34 SAY "  Phone: " get propl15
            @ 17,34 SAY "    FAX: " get propl16
            @ 18,34 SAY "Last     " get propl17
            @ 19,34 SAY "   Used: " get propl18
            read
            if lastkey()#27
                pp_savepp()
            endif
        case choice=3
            do while lastkey()#27
                @ 2,21 clear to 23,78
                string=space(50)
                @ 10,30 say "Enter macro string:" get string picture "@S20"
                @ 11,30 say "<ESC> to abort"
                read
                if lastkey()#27
                    @ 15,30 say "Result:"
                    @ 15,38 say &string
                    @ 17,30 say "Press any key.."
                    inkey(0)
                endif
            enddo
        otherwise
            exit_program()
    endcase
enddo .T.
return
FUNCTION exit_program
    pp_upddate()
    set color to
    clear
    cancel
return .T.
FUNCTION ucode
    PRIVATE _routine
    clear gets
    get_code=0
    @ 20,28 say "Enter code: " get get_code picture "@Z"
    read
    if lastkey()=27
        retu .T.
    endif
    _routine=pp_ucode(get_code)
    set color to
    clear
    do case
        case _routine=1
            if pp_unlock()
                @ 2,0 say "Application unlocked..."
            endif
        case _routine=2
            if pp_nexptype("P",pp_npdate(date(),20))
                @ 2,0 say "Application payment expire date extended to "+dtoc(pp_npdate(date(),20))
            endif
        case _routine=3
            if pp_killprot()
                @ 2,0 say "Protection erased!"
            endif
        case _routine=4
            if pp_nexptype("D",ctod("4/10/91"))
                @ 2,0 say "Application demo expire date set to 4/1/91"
            endif
        case _routine=10
            pp_copywrite()
        case _routine=0
            retu .F.
        otherwise
            @ 2,0 say "Routine # to be executed ="+str(_routine)
    endcase
    @ 4,0 say ""
    exit_program()
return .T.